home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok87 / statistik / statistik.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  158 lines
  1. (*------------------------------------------------------------------------------
  2.      :Program.    Statistik.mod
  3.      :Contents.   Berechnet eine Statistik von x/y Werten
  4.      :Author.     Matthias Scherrer
  5.      :Address.    Baselstrasse 63, CH-4242 Laufen
  6.      :Phone.      ++(0)61/7613975
  7.      :Copyright.  PD
  8.      :Language.   Oberon
  9.      :Translator. Oberon V3.00d
  10.      :History.    V1.0,01-Dec-92  fuer Oberon 2.14d
  11.      :History.    V1.1,29-Dec-92  angepasst an Oberon V3.00d
  12. ------------------------------------------------------------------------------*)
  13. MODULE Statistik;
  14.  
  15. IMPORT ml : MATHLIB;
  16.  
  17. TYPE  stat* = RECORD
  18.             n*      : INTEGER;    (* Anzahl Werte *)
  19.             Ex*,Ey*,              (* Summe x,y *)
  20.             maxx*,minx*,          (* Groesstes/kleinstes x/y *)  
  21.             maxy*,miny*,
  22.             Ex2*,Ey2*,            (* Summe x^2,y^2 *)
  23.             Exy*,                 (* Summe x*y *)
  24.             mx*, my*,             (* Mittelwert *)
  25.             sx*,sy*,              (* Streuung x,y *)
  26.             b*,c*,                (* lin.Regression y=b*x+c *)
  27.             sb*,sc*,              (* Streuung b,c *)
  28.             r*      : LONGREAL;   (* Korrelationskoeffizient *)
  29.       END;
  30.  
  31.  
  32. PROCEDURE Summe(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  33. VAR i   : INTEGER;
  34.     a,b : LONGREAL;
  35. BEGIN
  36.   i:=0; 
  37.   x.Ex:=0; x.Ey:=0; x.Ex2:=0; x.Ey2:=0; x.Exy:=0;
  38.   REPEAT 
  39.     a:=d[i,0]; b:=d[i,1];
  40.     x.Ex:=x.Ex+a;
  41.     x.Ey:=x.Ey+b;
  42.     x.Ex2:=x.Ex2+a*a;
  43.     x.Ey2:=x.Ey2+b*b;
  44.     x.Exy:=x.Exy+a*b;
  45.     INC(i);
  46.   UNTIL i>x.n;
  47. END Summe;
  48.  
  49.  
  50. PROCEDURE Mittelwert(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  51. VAR i : INTEGER;
  52. BEGIN
  53.   i:=0; x.mx:=0; x.my:=0;
  54.   REPEAT
  55.     x.mx:=x.mx+d[i,0];
  56.     x.my:=x.my+d[i,1];
  57.     INC(i);
  58.   UNTIL i>x.n;
  59.   IF (x.n+1)#0 THEN x.mx:=x.mx/(x.n+1); x.my:=x.my/(x.n+1); 
  60.                ELSE HALT(20) END;
  61. END Mittelwert;
  62.  
  63.  
  64. PROCEDURE MaxMin(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  65. VAR i         : INTEGER;
  66.     xmin,xmax,
  67.     ymin,ymax : LONGREAL;
  68. BEGIN
  69.   i:=0; 
  70.   xmin:=d[i,0]; xmax:=xmin; 
  71.   ymin:=d[i,1]; ymax:=ymin; 
  72.   REPEAT
  73.     IF d[i,0] > xmax THEN xmax:=d[i,0] END; 
  74.     IF d[i,0] < xmin THEN xmin:=d[i,0] END;
  75.     IF d[i,1] > ymax THEN ymax:=d[i,1] END; 
  76.     IF d[i,1] < ymin THEN ymin:=d[i,1] END;
  77.     INC(i);
  78.   UNTIL i>x.n;
  79.   x.maxx:= xmax; x.minx:=xmin;
  80.   x.maxy:= ymax; x.miny:=ymin;
  81. END MaxMin;
  82.  
  83.  
  84. PROCEDURE Streuung(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  85. VAR i : INTEGER;
  86. BEGIN
  87.   i:=0; 
  88.   REPEAT
  89.     x.sx:=x.sx+(d[i,0]-x.mx)*(d[i,0]-x.mx);
  90.     x.sy:=x.sy+(d[i,1]-x.my)*(d[i,1]-x.my);
  91.     INC(i);
  92.   UNTIL i>x.n;
  93.   IF x.n#0 THEN x.sx:=ml.SQRT(x.sx/x.n); x.sy:=ml.SQRT(x.sy/x.n); 
  94.            ELSE HALT(20) END;
  95. END Streuung;
  96.  
  97.  
  98. PROCEDURE LinReg(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  99. VAR i     : INTEGER;
  100.     n,z   : LONGREAL;
  101. BEGIN
  102.   n:=0; z:=0; i:=0;
  103.   REPEAT
  104.     z:=z+(d[i,0]-x.mx)*(d[i,1]-x.my);
  105.     n:=n+(d[i,0]-x.mx)*(d[i,0]-x.mx);
  106.     INC(i);
  107.   UNTIL i>x.n;
  108.   IF n#0 THEN x.b:=z/n; x.c:=x.my-x.b*x.mx ELSE HALT(20) END;
  109. END LinReg;
  110.  
  111.  
  112. PROCEDURE LinRegS(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  113. VAR t1,t2,t3,t4 : LONGREAL;
  114.     i           : INTEGER;
  115. BEGIN
  116.   i:=0; t1:=0; t2:=0; t4:=0;
  117.   REPEAT
  118.     t1:=t1+(d[i,1]-x.my)*(d[i,1]-x.my);
  119.     t2:=t2+(d[i,0]-x.mx)*(d[i,0]-x.mx);
  120.     t4:=t4+d[i,0]*d[i,0];
  121.     INC(i);
  122.   UNTIL i>x.n;
  123.   t3:=(x.n-1)*t2;
  124.   IF t3#0 THEN x.sb:=ml.SQRT((t1-x.b*x.b*t2)/t3) ELSE HALT(20) END;
  125.   IF (x.n+1)#0 THEN x.sc:=ml.SQRT(x.sb*x.sb*t4/(x.n+1)) ELSE HALT(20) END;
  126. END LinRegS;
  127.  
  128.  
  129. PROCEDURE KorrelKoeff(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  130. VAR t1,t2,t3 : LONGREAL;
  131.     i        : INTEGER;
  132. BEGIN
  133.   i:=0; t1:=0; t2:=0; t3:=0;
  134.   REPEAT
  135.     t1:=t1+(d[i,0]-x.mx)*(d[i,1]-x.my);
  136.     t2:=t2+(d[i,0]-x.mx)*(d[i,0]-x.mx);
  137.     t3:=t3+(d[i,1]-x.my)*(d[i,1]-x.my);
  138.     INC(i);
  139.   UNTIL i>x.n;
  140.   x.r:=t1/ml.SQRT(t2*t3);
  141.   IF x.r<0 THEN x.r:=-x.r END;
  142. END KorrelKoeff;
  143.  
  144.  
  145. PROCEDURE DoStat*(VAR x: stat; d: ARRAY OF ARRAY OF LONGREAL);
  146. BEGIN
  147.   Mittelwert(x,d);  (* MUSS zuerst aufgerufen werden! *)
  148.   Summe(x,d);       
  149.   MaxMin(x,d);
  150.   Streuung(x,d);
  151.   LinReg(x,d);      (* Lineare Regression *)
  152.   LinRegS(x,d);     (* Streuung d. linearen Regression *)
  153.   KorrelKoeff(x,d); (* Korrelationskoeffizient *)
  154. END DoStat;
  155.  
  156.  
  157. END Statistik.
  158.